home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
newrouts
/
newrouts.frm
(
.txt
)
< prev
next >
Wrap
Visual Basic Form
|
1997-06-13
|
16KB
|
498 lines
VERSION 4.00
Begin VB.Form frmNewRouts
Caption = "Add a new Routine"
ClientHeight = 3285
ClientLeft = 3540
ClientTop = 1905
ClientWidth = 4935
Height = 3975
Icon = "NewRouts.frx":0000
Left = 3480
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 3285
ScaleWidth = 4935
Top = 1275
Width = 5055
Begin VB.Frame Frame1
Height = 420
Left = 30
TabIndex = 15
Top = 0
Width = 4875
Begin VB.OptionButton optSub
Caption = "&Sub Procedure"
Height = 225
Left = 90
TabIndex = 17
Top = 135
Value = -1 'True
Width = 2055
End
Begin VB.OptionButton optFunction
Caption = "F&unction"
Height = 195
Left = 3135
TabIndex = 16
Top = 150
Width = 1455
End
End
Begin VB.TextBox txtMaxLen
BeginProperty Font
name = "Fixedsys"
charset = 0
weight = 400
size = 9
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 330
Left = 105
TabIndex = 8
Top = 2925
Visible = 0 'False
Width = 495
End
Begin VB.TextBox txtSinNum
BeginProperty Font
name = "Fixedsys"
charset = 0
weight = 400
size = 9
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 330
Left = 3465
TabIndex = 4
Top = 2430
Width = 1305
End
Begin VB.TextBox txtProgName
BeginProperty Font
name = "Fixedsys"
charset = 0
weight = 400
size = 9
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 330
Left = 1110
TabIndex = 1
Top = 885
Width = 3645
End
Begin VB.ComboBox cboRetType
BeginProperty Font
name = "Fixedsys"
charset = 0
weight = 400
size = 9
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 345
ItemData = "NewRouts.frx":0442
Left = 1110
List = "NewRouts.frx":0467
TabIndex = 3
Top = 2430
Width = 1275
End
Begin VB.CommandButton cmdAddVariable
Caption = "Add &Parameters ..."
Height = 345
Left = 3360
TabIndex = 5
Top = 2820
Width = 1470
End
Begin VB.CommandButton cmdAbort
Caption = "&Abort Build"
Height = 345
Left = 2280
TabIndex = 7
Top = 2835
Width = 1020
End
Begin VB.CommandButton cmdBuild
Caption = "&Build Routine"
Height = 330
Left = 1110
TabIndex = 6
Top = 2850
Width = 1125
End
Begin VB.TextBox txtDesc
BeginProperty Font
name = "Fixedsys"
charset = 0
weight = 400
size = 9
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 1065
Left = 1110
MultiLine = -1 'True
TabIndex = 2
Top = 1305
Width = 3645
End
Begin VB.TextBox txtAuthor
BeginProperty Font
name = "Fixedsys"
charset = 0
weight = 400
size = 9
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 330
Left = 1110
TabIndex = 0
Top = 510
Width = 3645
End
Begin VB.Label Label6
Caption = "Sin# (if any) :"
Height = 285
Left = 2565
TabIndex = 14
Top = 2445
Width = 885
End
Begin VB.Label Label5
Caption = "Function"
Height = 225
Left = 75
TabIndex = 13
Top = 2250
Width = 855
End
Begin VB.Label Label4
Caption = "Routine Name:"
Height = 390
Left = 45
TabIndex = 12
Top = 885
Width = 975
End
Begin VB.Label Label3
Caption = "Return Type :"
Height = 300
Left = 75
TabIndex = 11
Top = 2445
Width = 1065
End
Begin VB.Label Label2
Caption = "Description :"
Height = 345
Left = 75
TabIndex = 10
Top = 1305
Width = 990
End
Begin VB.Label Label1
Caption = "Author :"
Height = 255
Left = 60
TabIndex = 9
Top = 480
Width = 1050
End
Begin VB.Menu mnFile
Caption = "&File"
Begin VB.Menu mnExit
Caption = "&Exit"
End
End
Begin VB.Menu mnHelp
Caption = "&Help"
Begin VB.Menu mnAbout
Caption = "&About"
End
End
Attribute VB_Name = "frmNewRouts"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim retcode&
Private Sub cmdAbort_Click()
ResetScr
Unload Me
End Sub
Private Sub cmdAddVariable_Click()
Dim ub%, i%
On Error GoTo Loadfrm
ub% = UBound(gParms())
On Error GoTo 0
For i = 0 To ub%
frmAddVariables.lstVars.AddItem gParms(i)
Next i
Loadfrm:
frmAddVariables.Show vbModal
End Sub
Sub BuildRoutine()
'**************************************
'* Author : Michael J. Cox
'* Date : 6/13/97
'* Email : mikec247@ix.netcom.com
'*
'* Desc:
'* This routine does all the work.
'* It builds a temporary ascii file and
'* then load it into the active form.
'*
'* Modify this routine to customize the
'* new routine template.
'***********************************
On Error GoTo BuildRoutineErr
Dim CurForm As Object, maxlen%
Dim i%, nFileHnd%, dSub$, dDate$, oldtext$
Dim dArgs$, dParmsDesc$(), dParms$()
Dim dTab$, tParms%, dRetType$
dDate = Date
dTab$ = Space(4)
maxlen% = gMaxLen%
Set CurForm = gobjVBInst.ActiveProject.ActiveForm
On Error GoTo noParms
tParms% = UBound(gParms()) + 1
noParms:
On Error GoTo BuildRoutineErr
nFileHnd = FreeFile
Open App.Path & "\Routine.txt" For Output As nFileHnd
If gIsFunction And (cboRetType.Text) <> "" Then
dSub$ = "Function "
dRetType$ = " As " & Trim(cboRetType.Text)
Else
dSub$ = "Sub "
dRetType$ = ""
End If